home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 6 / FM Towns Free Software Collection 6.iso / ms_dos / happysrc / pccalusr.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-07-08  |  9.0 KB  |  230 lines
  1. /*********************************************************************
  2.  *
  3.  *   *** HAPPy Pascal Compiler ***
  4.  *      ユーザ定義の手続き､関数の呼出処理 
  5.  *  
  6.  *    void calluser(Set fsys, ctp *fcp) ;
  7.  *
  8.  *             Copyright (c) H.Asano 1992
  9.  *
  10.  *********************************************************************/
  11.  
  12. #define EXTERN extern
  13. #include "pascomp.h"
  14. #include "pcpcd.h"
  15.  
  16. extern void expression(Set) ;
  17. extern void selector(Set,ctp*) ;
  18. extern ctp  *searchid(Set)  ;
  19. extern Set  *mkset(Set*,int,...) ;
  20. extern Set  *orset(Set*,Set*);
  21. extern void enterid(ctp*)    ;
  22. extern ctp  *mkctp(char*,enum idclass,stp*,ctp*) ;
  23. extern void pcerr(int,char*) ;
  24. extern void insymbol(void)   ;
  25. extern boolean compatible(stp*,stp*) ;
  26. extern boolean assigncompati(stp*,stp*) ;
  27. extern int align(stp*,int)   ;
  28. extern void gen0(enum pcdmnc) ;
  29. extern void gen0t(enum pcdmnc,stp*) ;
  30. extern void gen1(enum pcdmnc,int) ;
  31. extern void gen2t(enum pcdmnc, stp*,int,int);
  32. extern void gencupent(enum pcdmnc,int,int) ; 
  33. extern void genjump(enum pcdmnc,int) ;
  34. extern void genldc(char,long) ;
  35. extern void load(void)        ;
  36. extern void loadaddress(void) ;
  37. extern void checkbounds(stp*,int) ;
  38. extern void skip(Set) ;
  39.  
  40. static int  pfparm(ctp *) ;
  41. static int actualparm(Set,ctp*) ;
  42. static boolean congruity(ctp*,ctp*) ;
  43.  
  44. /**********************************************/
  45. /* calluser() : ユーザ定義の手続き･関数の呼出 */
  46. /**********************************************/
  47. void calluser(Set fsys,ctp *fcp)
  48. {
  49.   ctp *nxt ;
  50.   enum idkind lkind ;
  51.   int locpar = 0;                       /* スタックにのせる引数のサイズ*/
  52.   boolean err126 = false ;
  53.  
  54.      lkind = fcp->n.pf.sd.d.pfkind ;    /* actual / formal            */
  55.  
  56.      if(lkind == actual) {              /* 実手続き､実関数の呼出の時  */
  57.       gen1(iMST,level-fcp->n.pf.sd.d.pflev) ; /* mst 命令 を 生成     */
  58.       nxt = fcp->next ;
  59.      }
  60.      else {                             /* 仮手続き､仮関数の呼出の時  */
  61.       gen2t(iLOD,nilptr,level-fcp->n.pf.sd.d.pflev,
  62.                 fcp->n.pf.sd.d.af.f.levadr) ; /* loda  mark           */
  63.       gen0(iMSI) ;                            /*  msi                 */
  64.       nxt = fcp->n.pf.sd.d.af.f.prm ;
  65.      }
  66.  
  67.      if(sy ==lparent) {
  68.       do {
  69.        insymbol() ;
  70.        if(!nxt && !err126) {
  71.         pcerr(126,"") ;                 /* 実引数と仮引数の数が違う   */
  72.         err126 = true ;
  73.        }
  74.        if(nxt && 
  75.         ((nxt->klass==proc) || (nxt->klass==func)))
  76.         locpar += pfparm(nxt) ;         /* 関数引数､手続き引数        */
  77.        else                             /* 値引数､変数引数            */
  78.         locpar += actualparm(fsys,nxt) ;
  79.        locpar = align(parmptr,locpar) ;
  80.  
  81.        if(nxt) nxt = nxt->next ;        /* 次の引数                   */
  82.  
  83.       } while(sy==comma) ;
  84.  
  85.       if(sy == rparent) insymbol() ;
  86.       else pcerr(4,"") ;                /* ) がない                   */
  87.      }
  88.  
  89.      if(nxt && !err126) pcerr(126,"") ; /* 実引数と仮引数の数が違う   */
  90.      
  91.  
  92.      if(lkind == actual)                /* 実手続き､実関数の呼出の時  */
  93.       gencupent(iCUP,locpar,fcp->n.pf.sd.d.af.a.pfname);/* cup命令生成*/
  94.      else {                             /* 仮手続き､仮関数の呼出の時  */
  95.       gen2t(iLOD,nilptr,level-fcp->n.pf.sd.d.pflev,
  96.                          fcp->n.pf.sd.d.af.f.adradr) ; /*loda 実行adr */
  97.       gen1(iCUI,locpar) ;               /* cui命令生成                */
  98.      }
  99.  
  100.      gattr.typtr = fcp->idtype ;        /* 手続き･関数の型            */
  101. }
  102.  
  103. /********************************************/
  104. /* actualparm() : 値､変数パラメータ処理     */
  105. /********************************************/
  106. static int actualparm(Set fsys,ctp *fnxt)
  107. {
  108.   stp *lsp ;
  109.   ctp *lcp ;
  110.   int locpar = 0 ;
  111.   Set ws,ws2 ;
  112.  
  113.      mkset(&ws,comma,rparent,-1) ;
  114.      mkset(&ws2,vars,field,-1)   ;
  115.      if(fnxt) {                         /* 引数がある                 */
  116.      
  117.       lsp = fnxt->idtype ;
  118.       if(fnxt->n.v.vkind == actual) {   /* 値引数の時                 */
  119.        expression(ws) ;                 /* 式の処理                   */
  120.        if(!assigncompati(lsp,gattr.typtr)) /* 代入可能性チェック      */
  121.         pcerr(155,"") ;                 /* 代入不可能                 */
  122.        if(lsp->form <= power) {         /* スカラ､範囲型､ポインタ､集合*/
  123.         load() ;                        /*   load命令                 */
  124.         if(lsp->form == power)
  125.          checkbounds(lsp,8) ;           /*  集合値の範囲チェック      */
  126.         else
  127.          checkbounds(lsp,7) ;           /*  順序型の範囲チェック      */ 
  128.         if((lsp == realptr) &&          /*   宣言がreal型で           */
  129.           compatible(gattr.typtr,intptr)) {  /* 実引数がintegerの時   */
  130.          gen0(iFLT) ;                   /*    flt命令生成             */
  131.          gattr.typtr = realptr ;
  132.         }
  133.         locpar = lsp->size ;            /* スタックに積む引数サイズ計算*/
  134.        }
  135.        else {                           /* 配列､レコード              */
  136.         loadaddress() ;                 /*   loadaddress命令          */
  137.         locpar = parmsize ;             /*   アドレス分のサイズ       */
  138.        }
  139.       } 
  140.       else  {                           /* 変数引数の時               */
  141.        if(sy == ident) {
  142.         lcp = searchid(ws2) ;           /* 変数､フィールド名から探す  */
  143.         insymbol() ;
  144.         selector(ws,lcp) ;
  145.         if(lsp != gattr.typtr)          /*   型が違う                 */
  146.          pcerr(142,"") ;                /*   仮引数と実引数の型不一致 */
  147.         loadaddress() ;                 /*   loadaddress命令          */
  148.         locpar = parmsize ;             /*   アドレス分のサイズ       */
  149.        }
  150.        else {
  151.         pcerr(6,"") ;                   /* 不当な記号が現れた         */
  152.         skip(ws)    ; 
  153.        } 
  154.       }
  155.      }
  156.      else expression(ws) ;            /* 仮引数がない時､とりあえず
  157.                                         実引数を式として処理しておく*/
  158.      return(locpar) ;
  159. }
  160.  
  161. /**************************************************/
  162. /* pfparm() : 手続き名､関数名実パラメータ処理     */
  163. /**************************************************/
  164. static int pfparm(ctp *fnxt)            /* fnxt:仮引数                */
  165. {
  166.   ctp *lcp , *lcp1;
  167.   Set ws;
  168.  
  169.      mkset(&ws, func,proc, -1);
  170.      lcp = searchid(ws) ;               /* 手続き名､関数名から探す    */
  171.      if(lcp->klass != fnxt->klass)      /* 引数の種類が違う           */
  172.       pcerr(142,"") ;                   /* 仮引数と実引数の型が不一致 */
  173.      else 
  174.       if(lcp->n.pf.pfdeckind == standard)
  175.        (lcp->klass==proc) ? pcerr(174,lcp->name) : pcerr(175,lcp->name);
  176.                                         /* 標準手続き･関数は実引数駄目*/
  177.       else {
  178.        lcp1 = (lcp->n.pf.sd.d.pfkind==actual)
  179.                  ? lcp->next : lcp->n.pf.sd.d.af.f.prm ;
  180.        if(!congruity(lcp1,fnxt->n.pf.sd.d.af.f.prm))
  181.         pcerr(127,lcp->name);           /* 同形でない                 */
  182.        else if(lcp->klass == func)
  183.         if(lcp->idtype != fnxt->idtype)
  184.          pcerr(173,lcp->name) ;         /* 関数の結果の型が違う       */
  185.       }
  186.  
  187.      if(lcp->n.pf.sd.d.pfkind==actual) {/* 実引数の時                 */
  188.       gen1(iBAS,level - lcp->n.pf.sd.d.pflev) ;/* baseアドレスを求める*/
  189.       genjump(iLAP,lcp->n.pf.sd.d.af.a.pfname);/*実行アドレス         */
  190.      }
  191.      else {                             /* 仮引数の時                 */
  192.       gen2t(iLOD,nilptr,level - lcp->n.pf.sd.d.pflev,
  193.                          lcp->n.pf.sd.d.af.f.levadr) ; /*loda 定義水準*/
  194.       gen2t(iLOD,nilptr,level - lcp->n.pf.sd.d.pflev,
  195.                          lcp->n.pf.sd.d.af.f.adradr) ; /*loda 実行adr */
  196.      }  
  197.  
  198.      insymbol() ;
  199.      return(2)  ; /* 暫定  アドレスサイズ×2を返せば良い */
  200. }
  201.  
  202. /******************************************/
  203. /* congruity() : パラメータの同形チェック */
  204. /******************************************/
  205. static boolean congruity(ctp *fcp1,ctp *fcp2)
  206. {
  207.      while(fcp1 && fcp2) {              /* 2つとも引数があれば        */
  208.       if(fcp1->klass != fcp2->klass)    /* 引数の種類が違う           */
  209.        return(false) ;
  210.       if(fcp1->klass == vars) {         /* 値､変数の時                */
  211.        if(fcp1->linkno != fcp2->linkno) /* 名前並びの数が違う         */
  212.         return(false) ;
  213.        if(fcp1->n.v.vkind != fcp2->n.v.vkind) /* 値､変数の種類が違う  */
  214.         return(false) ;
  215.        if(fcp1->idtype != fcp2->idtype) /* 型が違う                   */
  216.         return(false) ;
  217.       }
  218.       else {
  219.        if(fcp1->klass == func)          /* 関数引数の時               */
  220.         if(fcp1->idtype != fcp2->idtype)/*  関数の結果型が違う        */
  221.          return(false);
  222.        if(!congruity(fcp1->n.pf.sd.d.af.f.prm, fcp2->n.pf.sd.d.af.f.prm))               return(false) ;            /* それぞれの仮引数についてチェック*/
  223.       }
  224.       fcp1 = fcp1->next ;
  225.       fcp2 = fcp2->next ;
  226.      }
  227.      if((!fcp1) && (!fcp2)) return(true) ;/* 両方とも数が同じならOK   */
  228.      else                   return(false);/* 数が違えば          NG   */
  229. }
  230.